home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / units / dos.pp < prev    next >
Encoding:
Text File  |  2000-01-01  |  49.1 KB  |  1,780 lines
  1. {
  2.     $Id: dos.pp,v 1.8 1998/08/19 14:52:52 carl Exp $
  3.     This file is part of the Free Pascal run time library.
  4.     Copyright (c) 1998 by Nils Sjoholm and Carl Eric Codere
  5.     members of the Free Pascal development team
  6.       Date conversion routine taken from SWAG
  7.  
  8.     See the file COPYING.FPC, included in this distribution,
  9.     for details about the copyright.
  10.  
  11.     This program is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14.  
  15.  **********************************************************************}
  16.  
  17. Unit Dos;
  18.  
  19.  
  20. {--------------------------------------------------------------------}
  21. { LEFT TO DO:                                                        }
  22. {--------------------------------------------------------------------}
  23. { o DiskFree / Disksize don't work as expected                       }
  24. { o Implement SetDate and SetTime                                    }
  25. { o Implement EnvCount,EnvStr                                        }
  26. { o FindFirst should only work with correct attributes               }
  27. {--------------------------------------------------------------------}
  28.  
  29. {
  30.    History:
  31.    I have made an temporary fix for GetEnv('path')).
  32.    Now you get a string with all directories in your
  33.    path env. You can now do a fsearch('myfile',GetEnv('Path')).
  34.    This fix is just a tempfix, can be removed in the next
  35.    release. (or fixed).
  36.  
  37.    23 Jul 2000
  38.  
  39.    nils.sjoholm@mailbox.swipnet.se
  40.  
  41. }
  42.  
  43.  
  44.  
  45. Interface
  46.  
  47. {$I os.inc}
  48.  
  49.  
  50. Const
  51.   {Bitmasks for CPU Flags}
  52.   fcarry     = $0001;
  53.   fparity    = $0004;
  54.   fauxiliary = $0010;
  55.   fzero      = $0040;
  56.   fsign      = $0080;
  57.   foverflow  = $0800;
  58.  
  59.   {Bitmasks for file attribute}
  60.   readonly  = $01;
  61.   hidden    = $02;
  62.   sysfile   = $04;
  63.   volumeid  = $08;
  64.   directory = $10;
  65.   archive   = $20;
  66.   anyfile   = $3F;
  67.  
  68.   {File Status}
  69.   fmclosed = $D7B0;
  70.   fminput  = $D7B1;
  71.   fmoutput = $D7B2;
  72.   fminout  = $D7B3;
  73.  
  74.  
  75. Type
  76.   ComStr  = String[255];  { size increased to be more compatible with Unix}
  77.   PathStr = String[255];  { size increased to be more compatible with Unix}
  78.   DirStr  = String[255];  { size increased to be more compatible with Unix}
  79.   NameStr = String[255];  { size increased to be more compatible with Unix}
  80.   ExtStr  = String[255];  { size increased to be more compatible with Unix}
  81.  
  82.  
  83.  
  84. {
  85.   filerec.inc contains the definition of the filerec.
  86.   textrec.inc contains the definition of the textrec.
  87.   It is in a separate file to make it available in other units without
  88.   having to use the DOS unit for it.
  89. }
  90. {$i filerec.inc}
  91. {$i textrec.inc}
  92.  
  93.  
  94. Type
  95.  
  96.   SearchRec = Packed Record
  97.     { watch out this is correctly aligned for all processors }
  98.     { don't modify.                                          }
  99.     { Replacement for Fill }
  100. {0} AnchorPtr : Pointer;    { Pointer to the Anchorpath structure }
  101. {4} Fill: Array[1..15] of Byte; {future use}
  102.     {End of replacement for fill}
  103.     Attr : BYTE;        {attribute of found file}
  104.     Time : LongInt;     {last modify date of found file}
  105.     Size : LongInt;     {file size of found file}
  106.     Name : String[255]; {name of found file}
  107.   End;
  108.  
  109.  
  110.   DateTime = packed record
  111.     Year: Word;
  112.     Month: Word;
  113.     Day: Word;
  114.     Hour: Word;
  115.     Min: Word;
  116.     Sec: word;
  117.   End;
  118.  
  119.  
  120.  
  121. Var
  122.   DosError : integer;
  123.  
  124. {Interrupt}
  125. {Procedure Intr(intno: byte; var regs: registers);
  126. Procedure MSDos(var regs: registers);}
  127.  
  128. {Info/Date/Time}
  129. Function  DosVersion: Word;
  130. Procedure GetDate(var year, month, mday, wday: word);
  131. Procedure GetTime(var hour, minute, second, sec100: word);
  132. procedure SetDate(year,month,day: word);
  133. Procedure SetTime(hour,minute,second,sec100: word);
  134. Procedure UnpackTime(p: longint; var t: datetime);
  135. Procedure PackTime(var t: datetime; var p: longint);
  136.  
  137. {Exec}
  138. Procedure Exec(const path: pathstr; const comline: comstr);
  139. Function  DosExitCode: word;
  140.  
  141. {Disk}
  142. Function  DiskFree(drive: byte) : longint;
  143. Function  DiskSize(drive: byte) : longint;
  144. Procedure FindFirst(path: pathstr; attr: word; var f: searchRec);
  145. Procedure FindNext(var f: searchRec);
  146. Procedure FindClose(Var f: SearchRec);
  147.  
  148. {File}
  149. Procedure GetFAttr(var f; var attr: word);
  150. Procedure GetFTime(var f; var time: longint);
  151. Function  FSearch(path: pathstr; dirlist: string): pathstr;
  152. Function  FExpand(path: pathstr): pathstr;
  153. Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
  154.  
  155. {Environment}
  156. Function  EnvCount: longint;
  157. Function  EnvStr(index: integer): string;
  158. Function  GetEnv(envvar: string): string;
  159.  
  160. {Misc}
  161. Procedure SetFAttr(var f; attr: word);
  162. Procedure SetFTime(var f; time: longint);
  163. Procedure GetCBreak(var breakvalue: boolean);
  164. Procedure SetCBreak(breakvalue: boolean);
  165. Procedure GetVerify(var verify: boolean);
  166. Procedure SetVerify(verify: boolean);
  167.  
  168. {Do Nothing Functions}
  169. Procedure SwapVectors;
  170. Procedure GetIntVec(intno: byte; var vector: pointer);
  171. Procedure SetIntVec(intno: byte; vector: pointer);
  172. Procedure Keep(exitcode: word);
  173.  
  174. implementation
  175.  
  176. const
  177.   DaysPerMonth :  Array[1..12] of ShortInt =
  178. (031,028,031,030,031,030,031,031,030,031,030,031);
  179.   DaysPerYear  :  Array[1..12] of Integer  =
  180. (031,059,090,120,151,181,212,243,273,304,334,365);
  181.   DaysPerLeapYear :    Array[1..12] of Integer  =
  182. (031,060,091,121,152,182,213,244,274,305,335,366);
  183.   SecsPerYear      : LongInt  = 31536000;
  184.   SecsPerLeapYear  : LongInt  = 31622400;
  185.   SecsPerDay       : LongInt  = 86400;
  186.   SecsPerHour      : Integer  = 3600;
  187.   SecsPerMinute    : ShortInt = 60;
  188.   TICKSPERSECOND    = 50;
  189.  
  190.  
  191.  
  192. Type
  193.     pClockData = ^tClockData;
  194.     tClockData = packed Record
  195.       sec   : Word;
  196.       min   : Word;
  197.       hour  : Word;
  198.       mday  : Word;
  199.       month : Word;
  200.       year  : Word;
  201.       wday  : Word;
  202.     END;
  203.  
  204.     BPTR     = Longint;
  205.     BSTR     = Longint;
  206.  
  207.   pMinNode = ^tMinNode;
  208.   tMinNode = Packed Record
  209.     mln_Succ,
  210.     mln_Pred  : pMinNode;
  211.   End;
  212.  
  213.  
  214.     pMinList = ^tMinList;
  215.     tMinList = Packed record
  216.     mlh_Head        : pMinNode;
  217.     mlh_Tail        : pMinNode;
  218.     mlh_TailPred    : pMinNode;
  219.     end;
  220. { *  List Node Structure.  Each member in a list starts with a Node * }
  221.  
  222.   pNode = ^tNode;
  223.   tNode = Packed Record
  224.     ln_Succ,                { * Pointer to next (successor) * }
  225.     ln_Pred  : pNode;       { * Pointer to previous (predecessor) * }
  226.     ln_Type  : Byte;
  227.     ln_Pri   : Shortint;        { * Priority, for sorting * }
  228.     ln_Name  : PCHAR;       { * ID string, null terminated * }
  229.   End;  { * Note: Integer aligned * }
  230.  
  231.  
  232.  
  233.     pList = ^tList;
  234.     tList = Packed record
  235.     lh_Head     : pNode;
  236.     lh_Tail     : pNode;
  237.     lh_TailPred : pNode;
  238.     lh_Type     : Byte;
  239.     l_pad       : Byte;
  240.     end;
  241.  
  242.  
  243.    pMsgPort = ^tMsgPort;
  244.     tMsgPort = Packed record
  245.     mp_Node     : tNode;
  246.     mp_Flags    : Byte;
  247.     mp_SigBit   : Byte;     { signal bit number    }
  248.     mp_SigTask  : Pointer;   { task to be signalled (TaskPtr) }
  249.     mp_MsgList  : tList;     { message linked list  }
  250.     end;
  251.  
  252.  
  253.   pTask = ^tTask;
  254.     tTask = Packed record
  255.         tc_Node         : tNode;
  256.         tc_Flags        : Byte;
  257.         tc_State        : Byte;
  258.         tc_IDNestCnt    : Shortint;         { intr disabled nesting         }
  259.         tc_TDNestCnt    : Shortint;         { task disabled nesting         }
  260.         tc_SigAlloc     : Cardinal        { sigs allocated                }
  261.         tc_SigWait      : Cardinal;        { sigs we are waiting for       }
  262.         tc_SigRecvd     : Cardinal;        { sigs we have received         }
  263.         tc_SigExcept    : Cardinal;        { sigs we will take excepts for }
  264.         tc_TrapAlloc    : Word;        { traps allocated               }
  265.         tc_TrapAble     : Word;        { traps enabled                 }
  266.         tc_ExceptData   : Pointer;      { points to except data         }
  267.         tc_ExceptCode   : Pointer;      { points to except code         }
  268.         tc_TrapData     : Pointer;      { points to trap data           }
  269.         tc_TrapCode     : Pointer;      { points to trap code           }
  270.         tc_SPReg        : Pointer;      { stack pointer                 }
  271.         tc_SPLower      : Pointer;      { stack lower bound             }
  272.         tc_SPUpper      : Pointer;      { stack upper bound + 2         }
  273.         tc_Switch       : Pointer;      { task losing CPU               }
  274.         tc_Launch       : Pointer;      { task getting CPU              }
  275.         tc_MemEntry     : tList;        { allocated memory              }
  276.         tc_UserData     : Pointer;      { per task data                 }
  277.     end;
  278.  
  279.  
  280.  
  281.     TDateStamp = packed record
  282.         ds_Days         : Longint;      { Number of days since Jan. 1, 1978 }
  283.         ds_Minute       : Longint;      { Number of minutes past midnight }
  284.         ds_Tick         : Longint;      { Number of ticks past minute }
  285.     end;
  286.     PDateStamp = ^TDateStamp;
  287.  
  288.  
  289.  
  290. { Returned by Examine() and ExInfo(), must be on a 4 byte boundary }
  291.  
  292.     PFileInfoBlock = ^TfileInfoBlock;
  293.     TFileInfoBlock = packed record
  294.         fib_DiskKey     : Longint;
  295.         fib_DirEntryType : Longint;
  296.                         { Type of Directory. If < 0, then a plain file.
  297.                           If > 0 a directory }
  298.         fib_FileName    : Array [0..107] of Char;
  299.                         { Null terminated. Max 30 chars used for now }
  300.         fib_Protection  : Longint;
  301.                         { bit mask of protection, rwxd are 3-0. }
  302.         fib_EntryType   : Longint;
  303.         fib_Size        : Longint;      { Number of bytes in file }
  304.         fib_NumBlocks   : Longint;      { Number of blocks in file }
  305.         fib_Date        : TDateStamp; { Date file last changed }
  306.         fib_Comment     : Array [0..79] of Char;
  307.                         { Null terminated comment associated with file }
  308.         fib_Reserved    : Array [0..35] of Char;
  309.     end;
  310.  
  311. { returned by Info(), must be on a 4 byte boundary }
  312.  
  313.     pInfoData = ^tInfoData;
  314.     tInfoData = packed record
  315.         id_NumSoftErrors        : Longint;      { number of soft errors on disk }
  316.         id_UnitNumber           : Longint;      { Which unit disk is (was) mounted on }
  317.         id_DiskState            : Longint;      { See defines below }
  318.         id_NumBlocks            : Longint;      { Number of blocks on disk }
  319.         id_NumBlocksUsed        : Longint;      { Number of block in use }
  320.         id_BytesPerBlock        : Longint;
  321.         id_DiskType             : Longint;      { Disk Type code }
  322.         id_VolumeNode           : BPTR;         { BCPL pointer to volume node }
  323.         id_InUse                : Longint;      { Flag, zero if not in use }
  324.     end;
  325.  
  326.  
  327. { ------ Library Base Structure ---------------------------------- }
  328. {  Also used for Devices and some Resources  }
  329.  
  330.     pLibrary = ^tLibrary;
  331.     tLibrary = packed record
  332.         lib_Node     : tNode;
  333.         lib_Flags,
  334.         lib_pad      : Byte;
  335.         lib_NegSize,            {  number of bytes before library  }
  336.         lib_PosSize,            {  number of bytes after library  }
  337.         lib_Version,            {  major  }
  338.         lib_Revision : Word;    {  minor  }
  339.         lib_IdString : PCHAR;   {  ASCII identification  }
  340.         lib_Sum      : LONGINT; {  the checksum itself  }
  341.         lib_OpenCnt  : Word;    {  number of current opens  }
  342.     end;                {  * Warning: size is not a longword multiple ! * }
  343.  
  344.     PChain = ^TChain;
  345.     TChain = packed record
  346.       an_Child : PChain;
  347.       an_Parent: PChain;
  348.       an_Lock  : BPTR;
  349.       an_info  : TFileInfoBlock;
  350.       an_Flags : shortint;
  351.       an_string: Array[0..0] of char;
  352.     end;
  353.  
  354.  
  355.     PAnchorPath = ^TAnchorPath;
  356.     TAnchorPath = packed record
  357.        ap_Base      : PChain;     {* pointer to first anchor *}
  358.        ap_First     : PChain;     {* pointer to last anchor *}
  359.        ap_BreakBits : LONGINT;    {* Bits we want to break on *}
  360.        ap_FondBreak : LONGINT;    {* Bits we broke on. Also returns ERROR_BREAK *}
  361.        ap_Flags     : shortint;   {* New use for extra word. *}
  362.        ap_reserved  : BYTE;
  363.        ap_StrLen    : WORD;
  364.        ap_Info      : TFileInfoBlock;
  365.        ap_Buf       : Array[0..0] of Char; {* Buffer for path name, allocated by user *}
  366.     END;
  367.  
  368.     pCommandLineInterface = ^TCommandLineInterface;
  369.     TCommandLineInterface = packed record
  370.       cli_result2     : longint;    {* Value of IoErr from last command   *}
  371.       cli_SetName     : BSTR;       {* Name of current directory             *}
  372.       cli_CommandDir  : BPTR;       {* Head of the path locklist             *}
  373.       cli_ReturnCode  : longint;    {* Return code from last command          *}
  374.       cli_CommandName : BSTR;       {* Name of current command              *}
  375.       cli_FailLevel   : longint;    {* Fail level (set by FAILAT)            *}
  376.       cli_Prompt      : BSTR;       {* Current prompt (set by PROMPT)     *}
  377.       cli_StandardInput: BPTR;      {* Default (terminal) CLI input       *}
  378.       cli_CurrentInput : BPTR;      {* Current CLI input                       *}
  379.       cli_CommandFile  : BSTR;      {* Name of EXECUTE command file       *}
  380.       cli_Interactive  : longint;   {* Boolean; True if prompts required  *}
  381.       cli_Background   : longint    {* Boolean; True if CLI created by RUN*}
  382.       cli_CurrentOutput: BPTR;      {* Current CLI output                   *}
  383.       cli_DefautlStack : longint;   {* Stack size to be obtained in long words *}
  384.       cli_StandardOutput : BPTR;    {* Default (terminal) CLI output          *}
  385.       cli_Module       : BPTR;      {* SegList of currently loaded command*}
  386.     END;
  387.  
  388.   pDosList = ^tDosList;
  389.    tDosList = packed record
  390.     dol_Next            : BPTR;           {    bptr to next device on list }
  391.     dol_Type            : Longint;        {    see DLT below }
  392.     dol_Task            : Pointer;        {    ptr to handler task }
  393.     dol_Lock            : BPTR;
  394.     dol_Misc            : Array[0..23] of Shortint;
  395.     dol_Name            : BSTR;           {    bptr to bcpl name }
  396.    END;
  397.  
  398.     TProcess = packed record
  399.         pr_Task         : TTask;
  400.         pr_MsgPort      : TMsgPort;      { This is BPTR address from DOS functions  }
  401. {126}   pr_Pad          : Word;         { Remaining variables on 4 byte boundaries }
  402. {128}   pr_SegList      : Pointer;      { Array of seg lists used by this process  }
  403. {132}   pr_StackSize    : Longint;      { Size of process stack in bytes            }
  404. {136}   pr_GlobVec      : Pointer;      { Global vector for this process (BCPL)    }
  405. {140}   pr_TaskNum      : Longint;      { CLI task number of zero if not a CLI      }
  406. {144}   pr_StackBase    : BPTR;         { Ptr to high memory end of process stack  }
  407. {148}   pr_Result2      : Longint;      { Value of secondary result from last call }
  408. {152}   pr_CurrentDir   : BPTR;         { Lock associated with current directory   }
  409. {156}   pr_CIS          : BPTR;         { Current CLI Input Stream                  }
  410. {160}   pr_COS          : BPTR;         { Current CLI Output Stream                 }
  411. {164}   pr_ConsoleTask  : Pointer;      { Console handler process for current window}
  412. {168}   pr_FileSystemTask : Pointer;    { File handler process for current drive   }
  413. {172}   pr_CLI          : BPTR;         { pointer to ConsoleLineInterpreter         }
  414.         pr_ReturnAddr   : Pointer;      { pointer to previous stack frame           }
  415.         pr_PktWait      : Pointer;      { Function to be called when awaiting msg  }
  416.         pr_WindowPtr    : Pointer;      { Window for error printing }
  417.         { following definitions are new with 2.0 }
  418.         pr_HomeDir      : BPTR;         { Home directory of executing program      }
  419.         pr_Flags        : Longint;      { flags telling dos about process          }
  420.         pr_ExitCode     : Pointer;      { code to call on exit of program OR NULL  }
  421.         pr_ExitData     : Longint;      { Passed as an argument to pr_ExitCode.    }
  422.         pr_Arguments    : PChar;        { Arguments passed to the process at start }
  423.         pr_LocalVars    : TMinList;      { Local environment variables             }
  424.         pr_ShellPrivate : Longint;      { for the use of the current shell         }
  425.         pr_CES          : BPTR;         { Error stream - IF NULL, use pr_COS       }
  426.     end;
  427.     PProcess = ^TProcess;
  428.  
  429.  
  430. CONST
  431.     { DOS Lib Offsets }
  432.     _LVOMatchFirst = -822;
  433.     _LVOMatchNext  = -828;
  434.     _LVOMatchEnd   = -834;
  435.     _LVOCli        = -492;
  436.     _LVOExecute    = -222;
  437.     _LVOSystemTagList = -606;
  438.     _LVOSetFileDate = -396;
  439.  
  440.     LDF_READ   = 1;
  441.     LDF_DEVICES = 4;
  442.  
  443.     ERROR_NO_MORE_ENTRIES            = 232;
  444.     FIBF_SCRIPT         = 64;  { program is a script              }
  445.     FIBF_PURE           = 32;  { program is reentrant             }
  446.     FIBF_ARCHIVE        = 16;  { cleared whenever file is changed }
  447.     FIBF_READ           = 8;   { ignoed by old filesystem         }
  448.     FIBF_WRITE          = 4;   { ignored by old filesystem        }
  449.     FIBF_EXECUTE        = 2;   { ignored by system, used by shell }
  450.     FIBF_DELETE         = 1;   { prevent file from being deleted  }
  451.  
  452.     SHARED_LOCK         = -2;
  453.  
  454. {******************************************************************************
  455.                            --- Internal routines ---
  456. ******************************************************************************}
  457.  
  458.  
  459. procedure CurrentTime(var Seconds, Micros : Longint);
  460. Begin
  461.  asm
  462.     MOVE.L  A6,-(A7)
  463.     MOVE.L  Seconds,a0
  464.     MOVE.L  Micros,a1
  465.     MOVE.L  _IntuitionBase,A6
  466.     JSR -084(A6)
  467.     MOVE.L  (A7)+,A6
  468.  end;
  469. end;
  470.  
  471.  
  472. function Date2Amiga(date : pClockData) : Longint;
  473. Begin
  474.   asm
  475.     MOVE.L  A6,-(A7)
  476.     MOVE.L  date,a0
  477.     MOVE.L  _UtilityBase,A6
  478.     JSR -126(A6)
  479.     MOVE.L  (A7)+,A6
  480.     MOVE.L  d0,@RESULT
  481.   end;
  482. end;
  483.  
  484.  
  485. procedure Amiga2Date(amigatime : Longint;
  486.                      resultat : pClockData);
  487. Begin
  488.   asm
  489.     MOVE.L  A6,-(A7)
  490.     MOVE.L  amigatime,d0
  491.     MOVE.L  resultat,a0
  492.     MOVE.L  _UtilityBase,A6
  493.     JSR -120(A6)
  494.     MOVE.L  (A7)+,A6
  495.   end;
  496. end;
  497.  
  498. FUNCTION Examine(lock : BPTR; fileInfoBlock : pFileInfoBlock) : BOOLEAN;
  499. BEGIN
  500.   ASM
  501.     MOVE.L  A6,-(A7)
  502.     MOVE.L  lock,D1
  503.     MOVE.L  fileInfoBlock,D2
  504.     MOVEA.L _DOSBase,A6
  505.     JSR -102(A6)
  506.     MOVEA.L (A7)+,A6
  507.     TST.L   D0
  508.     BEQ.B   @end
  509.     MOVE.B  #1,D0
  510.     @end: MOVE.B  D0,@RESULT
  511.   END;
  512. END;
  513.  
  514. function Lock(const name : string;
  515.            accessmode : Longint) : BPTR;
  516. var
  517.  buffer: Array[0..255] of char;
  518. Begin
  519.   move(name[1],buffer,length(name));
  520.   buffer[length(name)]:=#0;
  521.   asm
  522.     MOVEM.L d2/a6,-(A7)
  523.     LEA     buffer,a0
  524.     MOVE.L  a0,d1
  525.     MOVE.L  accessmode,d2
  526.     MOVE.L  _DOSBase,A6
  527.     JSR -084(A6)
  528.     MOVEM.L (A7)+,d2/a6
  529.     MOVE.L  d0,@RESULT
  530.   end;
  531. end;
  532.  
  533.  
  534. procedure UnLock(lock : BPTR);
  535. Begin
  536.   asm
  537.     MOVE.L  A6,-(A7)
  538.     MOVE.L  lock,d1
  539.     MOVE.L  _DOSBase,A6
  540.     JSR -090(A6)
  541.     MOVE.L  (A7)+,A6
  542.   end;
  543. end;
  544.  
  545. FUNCTION Info(lock : BPTR; parameterBlock : pInfoData) : BOOLEAN;
  546. BEGIN
  547.   ASM
  548.     MOVE.L  A6,-(A7)
  549.     MOVE.L  lock,D1
  550.     MOVE.L  parameterBlock,D2
  551.     MOVEA.L _DOSBase,A6
  552.     JSR -114(A6)
  553.     MOVEA.L (A7)+,A6
  554.     TST.L   D0
  555.     BEQ.B   @end
  556.     MOVE.B  #1,D0
  557.     @end:
  558.      MOVE.B  D0,@RESULT
  559.   END;
  560. END;
  561.  
  562. FUNCTION NameFromLock(lock : BPTR; buffer : pCHAR; len : LONGINT) : BOOLEAN;
  563. BEGIN
  564.   ASM
  565.     MOVE.L  A6,-(A7)
  566.     MOVE.L  lock,D1
  567.     MOVE.L  buffer,D2
  568.     MOVE.L  len,D3
  569.     MOVEA.L _DOSBase,A6
  570.     JSR -402(A6)
  571.     MOVEA.L (A7)+,A6
  572.     TST.L   D0
  573.     BEQ.B   @end
  574.     MOVE.B  #1,D0
  575.     @end: MOVE.B  D0,@RESULT
  576.   END;
  577. END;
  578.  
  579. FUNCTION GetVar(name : pCHAR; buffer : pCHAR; size : LONGINT; flags : LONGINT) : LONGINT;
  580. BEGIN
  581.   ASM
  582.     MOVE.L  A6,-(A7)
  583.     MOVE.L  name,D1
  584.     MOVE.L  buffer,D2
  585.     MOVE.L  size,D3
  586.     MOVE.L  flags,D4
  587.     MOVEA.L _DOSBase,A6
  588.     JSR -906(A6)
  589.     MOVEA.L (A7)+,A6
  590.     MOVE.L  D0,@RESULT
  591.   END;
  592. END;
  593.  
  594. FUNCTION FindTask(name : pCHAR) : pTask;
  595. BEGIN
  596.   ASM
  597.     MOVE.L  A6,-(A7)
  598.     MOVEA.L name,A1
  599.     MOVEA.L _ExecBase,A6
  600.     JSR -294(A6)
  601.     MOVEA.L (A7)+,A6
  602.     MOVE.L  D0,@RESULT
  603.   END;
  604. END;
  605.  
  606. FUNCTION MatchFirst(pat : pCHAR; anchor : pAnchorPath) : LONGINT;
  607. BEGIN
  608.   ASM
  609.     MOVE.L  A6,-(A7)
  610.     MOVE.L  pat,D1
  611.     MOVE.L  anchor,D2
  612.     MOVEA.L _DOSBase,A6
  613.     JSR -822(A6)
  614.     MOVEA.L (A7)+,A6
  615.     MOVE.L  D0,@RESULT
  616.   END;
  617. END;
  618.  
  619. FUNCTION MatchNext(anchor : pAnchorPath) : LONGINT;
  620. BEGIN
  621.   ASM
  622.     MOVE.L  A6,-(A7)
  623.     MOVE.L  anchor,D1
  624.     MOVEA.L _DOSBase,A6
  625.     JSR -828(A6)
  626.     MOVEA.L (A7)+,A6
  627.     MOVE.L  D0,@RESULT
  628.   END;
  629. END;
  630.  
  631. PROCEDURE MatchEnd(anchor : pAnchorPath);
  632. BEGIN
  633.   ASM
  634.     MOVE.L  A6,-(A7)
  635.     MOVE.L  anchor,D1
  636.     MOVEA.L _DOSBase,A6
  637.     JSR -834(A6)
  638.     MOVEA.L (A7)+,A6
  639.   END;
  640. END;
  641.  
  642. FUNCTION Cli : pCommandLineInterface;
  643. BEGIN
  644.   ASM
  645.     MOVE.L  A6,-(A7)
  646.     MOVEA.L _DOSBase,A6
  647.     JSR -492(A6)
  648.     MOVEA.L (A7)+,A6
  649.     MOVE.L  D0,@RESULT
  650.   END;
  651. END;
  652.  
  653. Function _Execute(p: pchar): longint;
  654.  Begin
  655.    asm
  656.      move.l  a6,d6                 { save base pointer       }
  657.      move.l  d2,-(sp)
  658.      move.l  p,d1                  { command to execute      }
  659.      clr.l   d2                    { No TagList for command  }
  660.      move.l  _DosBase,a6
  661.      jsr     _LVOSystemTagList(a6)
  662.      move.l  (sp)+,d2
  663.      move.l  d6,a6                 { restore base pointer    }
  664.      move.l  d0,@RESULT
  665.    end;
  666. end;
  667.  
  668. FUNCTION LockDosList(flags : CARDINAL) : pDosList;
  669. BEGIN
  670.   ASM
  671.     MOVE.L  A6,-(A7)
  672.     MOVE.L  flags,D1
  673.     MOVEA.L _DOSBase,A6
  674.     JSR -654(A6)
  675.     MOVEA.L (A7)+,A6
  676.     MOVE.L  D0,@RESULT
  677.   END;
  678. END;
  679.  
  680.  
  681. PROCEDURE UnLockDosList(flags : CARDINAL);
  682. BEGIN
  683.   ASM
  684.     MOVE.L  A6,-(A7)
  685.     MOVE.L  flags,D1
  686.     MOVEA.L _DOSBase,A6
  687.     JSR -660(A6)
  688.     MOVEA.L (A7)+,A6
  689.   END;
  690. END;
  691.  
  692.  
  693. FUNCTION NextDosEntry(dlist : pDosList; flags : CARDINAL) : pDosList;
  694. BEGIN
  695.   ASM
  696.     MOVE.L  A6,-(A7)
  697.     MOVE.L  dlist,D1
  698.     MOVE.L  flags,D2
  699.     MOVEA.L _DOSBase,A6
  700.     JSR -690(A6)
  701.     MOVEA.L (A7)+,A6
  702.     MOVE.L  D0,@RESULT
  703.   END;
  704. END;
  705.  
  706.  
  707. FUNCTION BADDR(bval : BPTR): POINTER;
  708. BEGIN
  709.     BADDR := POINTER( bval shl 2);
  710. END;
  711.  
  712. function PasToC(var s: string): Pchar;
  713. var i: integer;
  714. begin
  715.     i := Length(s) + 1;
  716.     if i > 255 then
  717.     begin
  718.         Delete(s, 255, 1);      { ensure there is a spare byte }
  719.         Dec(i)
  720.     end;
  721.     s[i]     := #0;
  722.     PasToC := @s[1]
  723. end;
  724.  
  725.  
  726. Procedure AmigaToDt(SecsPast: LongInt; Var Dt: DateTime);
  727. var
  728.   cd : pClockData;
  729. Begin
  730.   New(cd);
  731.   Amiga2Date(SecsPast,cd);
  732.   Dt.sec   := cd^.sec;
  733.   Dt.min   := cd^.min;
  734.   Dt.hour  := cd^.hour;
  735.   Dt.day   := cd^.mday;
  736.   Dt.month := cd^.month;
  737.   Dt.year  := cd^.year;
  738.   Dispose(cd);
  739. End;
  740.  
  741. Function DtToAmiga(DT: DateTime): LongInt;
  742. var
  743.   cd : pClockData;
  744.   temp : Longint;
  745. Begin
  746.   New(cd);
  747.   cd^.sec   := Dt.sec;
  748.   cd^.min   := Dt.min;
  749.   cd^.hour  := Dt.hour;
  750.   cd^.mday  := Dt.day;
  751.   cd^.month := Dt.month;
  752.   cd^.year  := Dt.year;
  753.   temp := Date2Amiga(cd);
  754.   Dispose(cd);
  755.   DtToAmiga := temp;
  756. end;
  757.  
  758. Function SetProtection(const name: string; mask:longint): longint;
  759.  var
  760.   buffer : array[0..255] of char;
  761.  Begin
  762.    move(name[1],buffer,length(name));
  763.    buffer[length(name)]:=#0;
  764.    asm
  765.       move.l  a6,d6
  766.       lea     buffer,a0
  767.       move.l  a0,d1
  768.       move.l  mask,d2
  769.       move.l  _DosBase,a6
  770.       jsr     -186(a6)
  771.       move.l  d6,a6
  772.       move.l  d0,@RESULT
  773.    end;
  774.  end;
  775.  
  776.  
  777. Function IsLeapYear(Source : Word) : Boolean;
  778. Begin
  779.   If (Source Mod 4 = 0) Then
  780.     IsLeapYear := True
  781.   Else
  782.     IsLeapYear := False;
  783. End;
  784.  
  785.  
  786. Procedure Amiga2DateStamp(Date : LongInt; Var TotalDays,Minutes,Ticks: longint);
  787. { Converts a value in seconds past 1978 to a value in AMIGA DateStamp format }
  788. { Taken from SWAG and modified to work with the Amiga format - CEC           }
  789. Var
  790.   LocalDate : LongInt; Done : Boolean; X : ShortInt; TotDays : Integer;
  791.   Y: Word;
  792.   M: Word;
  793.   D: Word;
  794.   H: Word;
  795.   Min: Word;
  796.   S : Word;
  797. Begin
  798.   Y   := 1978; M := 1; D := 1; H := 0; Min := 0; S := 0;
  799.   TotalDays := 0;
  800.   Minutes := 0;
  801.   Ticks := 0;
  802.   LocalDate := Date;
  803.   Done := False;
  804.   While Not Done Do
  805.   Begin
  806.     If LocalDate >= SecsPerYear Then
  807.     Begin
  808.       Inc(Y,1);
  809.       Dec(LocalDate,SecsPerYear);
  810.       Inc(TotalDays,DaysPerYear[12]);
  811.     End
  812.     Else
  813.       Done := True;
  814.     If (IsLeapYear(Y+1)) And (LocalDate >= SecsPerLeapYear) And
  815.        (Not Done) Then
  816.     Begin
  817.       Inc(Y,1);
  818.       Dec(LocalDate,SecsPerLeapYear);
  819.       Inc(TotalDays,DaysPerLeapYear[12]);
  820.     End;
  821.   End; { END WHILE }
  822.   M := 1; D := 1;
  823.   Done := False;
  824.   TotDays := LocalDate Div SecsPerDay;
  825.   { Total number of days }
  826.   TotalDays := TotalDays + TotDays;
  827.     Dec(LocalDate,TotDays*SecsPerDay);
  828.   { Absolute hours since start of day }
  829.   H := LocalDate Div SecsPerHour;
  830.   { Convert to minutes }
  831.   Minutes := H*60;
  832.     Dec(LocalDate,(H * SecsPerHour));
  833.   { Find the remaining minutes to add }
  834.   Min := LocalDate Div SecsPerMinute;
  835.     Dec(LocalDate,(Min * SecsPerMinute));
  836.   Minutes:=Minutes+Min;
  837.   { Find the number of seconds and convert to ticks }
  838.   S := LocalDate;
  839.   Ticks:=TICKSPERSECOND*S;
  840. End;
  841.  
  842.  
  843.   Function SetFileDate(name: string; p : pDateStamp): longint;
  844.   var
  845.     buffer : array[0..255] of char;
  846.   Begin
  847.     move(name[1],buffer,length(name));
  848.     buffer[length(name)]:=#0;
  849.      asm
  850.        move.l a6,d6           { save base pointer }
  851.        move.l d2,-(sp)        { save reserved reg }
  852.        lea    buffer,a0
  853.        move.l a0,d1
  854.        move.l p,d2
  855.        move.l _DosBase,a6
  856.        jsr    _LVOSetFileDate(a6)
  857.        move.l (sp)+,d2        { restore reserved reg }
  858.        move.l d6,a6           { restore base pointer }
  859.        move.l d0,@Result
  860.      end;
  861.   end;
  862.  
  863.  
  864.  
  865.  
  866.  
  867. {******************************************************************************
  868.                            --- Dos Interrupt ---
  869. ******************************************************************************}
  870.  
  871. (*Procedure Intr (intno: byte; var regs: registers);
  872.   Begin
  873.   { Does not apply to Linux - not implemented }
  874.   End;*)
  875.  
  876.  
  877. Procedure SwapVectors;
  878.   Begin
  879.   { Does not apply to Linux - Do Nothing }
  880.   End;
  881.  
  882.  
  883. (*Procedure msdos(var regs : registers);
  884.   Begin
  885.   { ! Not implemented in Linux ! }
  886.   End;*)
  887.  
  888.  
  889. Procedure getintvec(intno : byte;var vector : pointer);
  890.   Begin
  891.   { ! Not implemented in Linux ! }
  892.   End;
  893.  
  894.  
  895. Procedure setintvec(intno : byte;vector : pointer);
  896.   Begin
  897.   { ! Not implemented in Linux ! }
  898.   End;
  899.  
  900. {******************************************************************************
  901.                         --- Info / Date / Time ---
  902. ******************************************************************************}
  903.  
  904.   Function DosVersion: Word;
  905.    var p: pLibrary;
  906.   Begin
  907.     p:=pLibrary(_DosBase);
  908.     DosVersion:= p^.lib_Version or (p^.lib_Revision shl 8);
  909.   End;
  910.  
  911. Procedure GetDate(Var Year, Month, MDay, WDay: Word);
  912. Var
  913.   cd    : pClockData;
  914.   mysec,
  915.   tick  : Longint;
  916. begin
  917.   New(cd);
  918.   CurrentTime(mysec,tick);
  919.   Amiga2Date(mysec,cd);
  920.   Year  := cd^.year;
  921.   Month := cd^.month;
  922.   MDay  := cd^.mday;
  923.   WDay  := cd^.wday;
  924.   Dispose(cd);
  925. end;
  926.  
  927. Procedure SetDate(Year, Month, Day: Word);
  928.   Begin
  929.   { !! }
  930.   End;
  931.  
  932. Procedure GetTime(Var Hour, Minute, Second, Sec100: Word);
  933. Var
  934.   mysec,
  935.   tick    : Longint;
  936.   cd      : pClockData;
  937. begin
  938.   New(cd);
  939.   CurrentTime(mysec,tick);
  940.   Amiga2Date(mysec,cd);
  941.   Hour   := cd^.hour;
  942.   Minute := cd^.min;
  943.   Second := cd^.sec;
  944.   Sec100 := 0;
  945.   Dispose(cd);
  946. END;
  947.  
  948.  
  949. Procedure SetTime(Hour, Minute, Second, Sec100: Word);
  950.   Begin
  951.   { !! }
  952.   End;
  953.  
  954. Procedure unpacktime(p : longint;var t : datetime);
  955. Begin
  956.   AmigaToDt(p,t);
  957. End;
  958.  
  959.  
  960. Procedure packtime(var t : datetime;var p : longint);
  961. Begin
  962.   p := DtToAmiga(t);
  963. end;
  964.  
  965.  
  966. {******************************************************************************
  967.                                --- Exec ---
  968. ******************************************************************************}
  969.  
  970.  
  971. Var
  972.   LastDosExitCode: word;
  973.   breakflag : Boolean;
  974.   ver: Boolean;
  975.  
  976.  
  977. Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
  978.   var
  979.    p : string;
  980.    buf: array[0..255] of char;
  981.    result : longint;
  982.    MyLock : longint;
  983.    i : Integer;
  984.   Begin
  985.    DosError := 0;
  986.    LastdosExitCode := 0;
  987.    p:=Path+' '+ComLine;
  988.    { allow backslash as slash }
  989.    for i:=1 to length(p) do
  990.        if p[i]='\' then p[i]:='/';
  991.    Move(p[1],buf,length(p));
  992.    buf[Length(p)]:=#0;
  993.    { Here we must first check if the command we wish to execute }
  994.    { actually exists, because this is NOT handled by the        }
  995.    { _SystemTagList call (program will abort!!)                 }
  996.  
  997.    { Try to open with shared lock                               }
  998.    MyLock:=Lock(path,SHARED_LOCK);
  999.    if MyLock <> 0 then
  1000.      Begin
  1001.         { File exists - therefore unlock it }
  1002.         Unlock(MyLock);
  1003.         result:=_Execute(buf);
  1004.         { on return of -1 the shell could not be executed }
  1005.         { probably because there was not enough memory    }
  1006.         if result = -1 then
  1007.           DosError:=8
  1008.         else
  1009.           LastDosExitCode:=word(result);
  1010.      end
  1011.    else
  1012.     DosError:=3;
  1013.   End;
  1014.  
  1015.  
  1016. Function DosExitCode: Word;
  1017.   Begin
  1018.     DosExitCode:=LastdosExitCode;
  1019.   End;
  1020.  
  1021.  
  1022.   Procedure GetCBreak(Var BreakValue: Boolean);
  1023.   Begin
  1024.    breakvalue:=breakflag;
  1025.   End;
  1026.  
  1027.  
  1028.  Procedure SetCBreak(BreakValue: Boolean);
  1029.   Begin
  1030.    breakflag:=BreakValue;
  1031.   End;
  1032.  
  1033.  
  1034.   Procedure GetVerify(Var Verify: Boolean);
  1035.    Begin
  1036.      verify:=ver;
  1037.    End;
  1038.  
  1039.  
  1040.  Procedure SetVerify(Verify: Boolean);
  1041.   Begin
  1042.     ver:=Verify;
  1043.   End;
  1044.  
  1045. {******************************************************************************
  1046.                                --- Disk ---
  1047. ******************************************************************************}
  1048.  
  1049. { How to solve the problem with this:       }
  1050. {  We could walk through the device list    }
  1051. {  at startup to determine possible devices }
  1052.  
  1053. const
  1054.  
  1055.   not_to_use_devs : array[0..12] of string =(
  1056.                    'DF0:',
  1057.                    'DF1:',
  1058.                    'DF2:',
  1059.                    'DF3:',
  1060.                    'PED:',
  1061.                    'PRJ:',
  1062.                    'PIPE:',
  1063.                    'RAM:',
  1064.                    'CON:',
  1065.                    'RAW:',
  1066.                    'SER:',
  1067.                    'PAR:',
  1068.                    'PRT:');
  1069.  
  1070. var
  1071.    deviceids : array[1..20] of byte;
  1072.    devicenames : array[1..20] of string[20];
  1073.    numberofdevices : Byte;
  1074.  
  1075. Function DiskFree(Drive: Byte): Longint;
  1076. Var
  1077.   MyLock      : BPTR;
  1078.   Inf         : pInfoData;
  1079.   Free        : Longint;
  1080.   myproc      : pProcess;
  1081.   OldWinPtr   : Pointer;
  1082. Begin
  1083.   Free := -1;
  1084.   { Here we stop systemrequesters to appear }
  1085.   myproc := pProcess(FindTask(nil));
  1086.   OldWinPtr := myproc^.pr_WindowPtr;
  1087.   myproc^.pr_WindowPtr := Pointer(-1);
  1088.   { End of systemrequesterstop }
  1089.   New(Inf);
  1090.   MyLock := Lock(devicenames[deviceids[Drive]],SHARED_LOCK);
  1091.   If MyLock <> 0 then begin
  1092.      if Info(MyLock,Inf) then begin
  1093.         Free := (Inf^.id_NumBlocks * Inf^.id_BytesPerBlock) -
  1094.                 (Inf^.id_NumBlocksUsed * Inf^.id_BytesPerBlock);
  1095.      end;
  1096.      Unlock(MyLock);
  1097.   end;
  1098.   Dispose(Inf);
  1099.   { Restore systemrequesters }
  1100.   myproc^.pr_WindowPtr := OldWinPtr;
  1101.   diskfree := Free;
  1102. end;
  1103.  
  1104.  
  1105.  
  1106. Function DiskSize(Drive: Byte): Longint;
  1107. Var
  1108.   MyLock      : BPTR;
  1109.   Inf         : pInfoData;
  1110.   Size        : Longint;
  1111.   myproc      : pProcess;
  1112.   OldWinPtr   : Pointer;
  1113. Begin
  1114.   Size := -1;
  1115.   { Here we stop systemrequesters to appear }
  1116.   myproc := pProcess(FindTask(nil));
  1117.   OldWinPtr := myproc^.pr_WindowPtr;
  1118.   myproc^.pr_WindowPtr := Pointer(-1);
  1119.   { End of systemrequesterstop }
  1120.   New(Inf);
  1121.   MyLock := Lock(devicenames[deviceids[Drive]],SHARED_LOCK);
  1122.   If MyLock <> 0 then begin
  1123.      if Info(MyLock,Inf) then begin
  1124.         Size := (Inf^.id_NumBlocks * Inf^.id_BytesPerBlock);
  1125.      end;
  1126.      Unlock(MyLock);
  1127.   end;
  1128.   Dispose(Inf);
  1129.   { Restore systemrequesters }
  1130.   myproc^.pr_WindowPtr := OldWinPtr;
  1131.   disksize := Size;
  1132. end;
  1133.  
  1134.  
  1135.  
  1136.  
  1137. Procedure FindFirst(Path: PathStr; Attr: Word; Var f: SearchRec);
  1138. var
  1139.  buf: Array[0..255] of char;
  1140.  Anchor : pAnchorPath;
  1141.  Result : Longint;
  1142.  index : Integer;
  1143.  s     : string;
  1144.  j     : integer;
  1145. Begin
  1146.  DosError:=0;
  1147.  New(Anchor);
  1148.  {----- allow backslash as slash         -----}
  1149.  for index:=1 to length(path) do
  1150.    if path[index]='\' then path[index]:='/';
  1151.  { remove any dot characters and replace by their current }
  1152.  { directory equivalent.                                  }
  1153.  if pos('../',path) = 1 then
  1154.  { look for parent directory }
  1155.     Begin
  1156.        delete(path,1,3);
  1157.        getdir(0,s);
  1158.        j:=length(s);
  1159.        while (s[j] <> '/') AND (s[j] <> ':') AND (j > 0 ) do
  1160.          dec(j);
  1161.        if j > 0 then
  1162.          s:=copy(s,1,j);
  1163.        path:=s+path;
  1164.     end
  1165.  else
  1166.  if pos('./',path) = 1 then
  1167.  { look for current directory }
  1168.     Begin
  1169.        delete(path,1,2);
  1170.        getdir(0,s);
  1171.        if (s[length(s)] <> '/') and (s[length(s)] <> ':') then
  1172.           s:=s+'/';
  1173.        path:=s+path;
  1174.     end;
  1175.  {----- replace * by #? AmigaOs strings  -----}
  1176.  repeat
  1177.   index:= pos('*',Path);
  1178.   if index <> 0 then
  1179.    Begin
  1180.      delete(Path,index,1);
  1181.      insert('#?',Path,index);
  1182.    end;
  1183.  until index =0;
  1184.  {--------------------------------------------}
  1185.  FillChar(Anchor^,sizeof(TAnchorPath),#0);
  1186.  move(path[1],buf,length(path));
  1187.  buf[length(path)]:=#0;
  1188.  
  1189.  Result:=MatchFirst(@buf,Anchor);
  1190.  f.AnchorPtr:=Anchor;
  1191.  if Result = ERROR_NO_MORE_ENTRIES then
  1192.    DosError:=18
  1193.  else
  1194.  if Result <> 0 then
  1195.    DosError:=3;
  1196.  { If there is an error, deallocate }
  1197.  { the anchorpath structure         }
  1198.  if DosError <> 0 then
  1199.    Begin
  1200.      MatchEnd(Anchor);
  1201.      if assigned(Anchor) then
  1202.        Dispose(Anchor);
  1203.    end
  1204.  else
  1205.  {-------------------------------------------------------------------}
  1206.  { Here we fill up the SearchRec attribute, but we also do check     }
  1207.  { something else, if the it does not match the mask we are looking  }
  1208.  { for we should go to the next file or directory.                   }
  1209.  {-------------------------------------------------------------------}
  1210.    Begin
  1211.          with Anchor^.ap_Info do
  1212.           Begin
  1213.              f.Time := fib_Date.ds_Days * (24 * 60 * 60) +
  1214.              fib_Date.ds_Minute * 60 +
  1215.              fib_Date.ds_Tick div 50;
  1216.            {*------------------------------------*}
  1217.            {* Determine if is a file or a folder *}
  1218.            {*------------------------------------*}
  1219.            if fib_DirEntryType > 0 then
  1220.                f.attr:=f.attr OR DIRECTORY;
  1221.  
  1222.            {*------------------------------------*}
  1223.            {* Determine if Read only             *}
  1224.            {*  Readonly if R flag on and W flag  *}
  1225.            {*   off.                             *}
  1226.            {* Should we check also that EXEC     *}
  1227.            {* is zero? for read only?            *}
  1228.            {*------------------------------------*}
  1229.            if   ((fib_Protection and FIBF_READ) <> 0)
  1230.             AND ((fib_Protection and FIBF_WRITE) = 0)
  1231.            then
  1232.               f.attr:=f.attr or READONLY;
  1233.            f.Name := strpas(fib_FileName);
  1234.            f.Size := fib_Size;
  1235.          end; { end with }
  1236.    end;
  1237. End;
  1238.  
  1239.  
  1240. Procedure FindNext(Var f: SearchRec);
  1241. var
  1242.  Result: longint;
  1243.  Anchor : pAnchorPath;
  1244. Begin
  1245.  DosError:=0;
  1246.  Result:=MatchNext(f.AnchorPtr);
  1247.  if Result = ERROR_NO_MORE_ENTRIES then
  1248.    DosError:=18
  1249.  else
  1250.  if Result <> 0 then
  1251.    DosError:=3;
  1252.  { If there is an error, deallocate }
  1253.  { the anchorpath structure         }
  1254.  if DosError <> 0 then
  1255.    Begin
  1256.      MatchEnd(f.AnchorPtr);
  1257.      if assigned(f.AnchorPtr) then
  1258.        Dispose(f.AnchorPtr);
  1259.    end
  1260.  else
  1261.  { Fill up the Searchrec information     }
  1262.  { and also check if the files are with  }
  1263.  { the correct attributes                }
  1264.    Begin
  1265.          Anchor:=pAnchorPath(f.AnchorPtr);
  1266.          with Anchor^.ap_Info do
  1267.           Begin
  1268.              f.Time := fib_Date.ds_Days * (24 * 60 * 60) +
  1269.              fib_Date.ds_Minute * 60 +
  1270.              fib_Date.ds_Tick div 50;
  1271.            {*------------------------------------*}
  1272.            {* Determine if is a file or a folder *}
  1273.            {*------------------------------------*}
  1274.            if fib_DirEntryType > 0 then
  1275.                f.attr:=f.attr OR DIRECTORY;
  1276.  
  1277.            {*------------------------------------*}
  1278.            {* Determine if Read only             *}
  1279.            {*  Readonly if R flag on and W flag  *}
  1280.            {*   off.                             *}
  1281.            {* Should we check also that EXEC     *}
  1282.            {* is zero? for read only?            *}
  1283.            {*------------------------------------*}
  1284.            if   ((fib_Protection and FIBF_READ) <> 0)
  1285.             AND ((fib_Protection and FIBF_WRITE) = 0)
  1286.            then
  1287.               f.attr:=f.attr or READONLY;
  1288.            f.Name := strpas(fib_FileName);
  1289.            f.Size := fib_Size;
  1290.          end; { end with }
  1291.    end;
  1292. End;
  1293.  
  1294.     Procedure FindClose(Var f: SearchRec);
  1295.       begin
  1296.       end;
  1297.  
  1298. {******************************************************************************
  1299.                                --- File ---
  1300. ******************************************************************************}
  1301.  
  1302. Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
  1303. var
  1304.   I: Word;
  1305. begin
  1306.   { allow backslash as slash }
  1307.   for i:=1 to length(path) do
  1308.     if path[i]='\' then path[i]:='/';
  1309.  
  1310.   I := Length(Path);
  1311.   while (I > 0) and not ((Path[I] = '/') or (Path[I] = ':'))
  1312.      do Dec(I);
  1313.   if Path[I] = '/' then
  1314.      dir := Copy(Path, 0, I)
  1315.   else dir := Copy(Path,0,I);
  1316.  
  1317.   if Length(Path) > Length(dir) then
  1318.       name := Copy(Path, I + 1, Length(Path)-I)
  1319.   else
  1320.       name := '';
  1321.   { Remove extension }
  1322.   if pos('.',name) <> 0 then
  1323.      delete(name,pos('.',name),length(name));
  1324.  
  1325.   I := Pos('.',Path);
  1326.   if I > 0 then
  1327.      ext := Copy(Path,I,Length(Path)-(I-1))
  1328.      else ext := '';
  1329. end;
  1330.  
  1331. Function FExpand(Path: PathStr): PathStr;
  1332. var
  1333.     FLock  : BPTR;
  1334.     buffer : array[0..255] of char;
  1335.     i :integer;
  1336.     j :integer;
  1337.     temp : string;
  1338. begin
  1339.  
  1340.    { allow backslash as slash }
  1341.     for i:=1 to length(path) do
  1342.        if path[i]='\' then path[i]:='/';
  1343.  
  1344.    temp:=path;
  1345.    if pos('../',temp) = 1 then
  1346.      delete(temp,1,3);
  1347.    if pos('./',temp) = 1 then
  1348.       delete(temp,1,2);
  1349.    {First remove all references to '/./'}
  1350.     while pos('/./',temp)<>0 do
  1351.       delete(temp,pos('/./',temp),3);
  1352.    {Now remove also all references to '/../' + of course previous dirs..}
  1353.     repeat
  1354.       i:=pos('/../',temp);
  1355.       {Find the pos of the previous dir}
  1356.       if i>1 then
  1357.         begin
  1358.           j:=i-1;
  1359.           while (j>1) and (temp[j]<>'/') do
  1360.              dec (j);{temp[1] is always '/'}
  1361.           delete(temp,j,i-j+4);
  1362.         end
  1363.       else
  1364.       if i=1 then  {i=1, so we have temp='/../something', just delete '/../'}
  1365.        delete(temp,1,4);
  1366.     until i=0;
  1367.  
  1368.  
  1369.     FLock := Lock(temp,-2);
  1370.     if FLock <> 0 then begin
  1371.        if NameFromLock(FLock,buffer,255) then begin
  1372.           Unlock(FLock);
  1373.           FExpand := strpas(buffer);
  1374.        end else begin
  1375.           Unlock(FLock);
  1376.           FExpand := '';
  1377.        end;
  1378.     end else FExpand := '';
  1379. end;
  1380.  
  1381.  
  1382.    Function  fsearch(path : pathstr;dirlist : string) : pathstr;
  1383.       var
  1384.          i,p1   : longint;
  1385.          s      : searchrec;
  1386.          newdir : pathstr;
  1387.       begin
  1388.       { No wildcards allowed in these things }
  1389.          if (pos('?',path)<>0) or (pos('*',path)<>0) then
  1390.            fsearch:=''
  1391.          else
  1392.            begin
  1393.               { allow slash as backslash }
  1394.               for i:=1 to length(dirlist) do
  1395.                 if dirlist[i]='\' then dirlist[i]:='/';
  1396.               repeat
  1397.                 p1:=pos(';',dirlist);
  1398.                 if p1<>0 then
  1399.                  begin
  1400.                    newdir:=copy(dirlist,1,p1-1);
  1401.                    delete(dirlist,1,p1);
  1402.                  end
  1403.                 else
  1404.                  begin
  1405.                    newdir:=dirlist;
  1406.                    dirlist:='';
  1407.                  end;
  1408.                 if (newdir<>'') and (not (newdir[length(newdir)] in ['/',':'])) then
  1409.                  newdir:=newdir+'/';
  1410.                 findfirst(newdir+path,anyfile,s);
  1411.                 if doserror=0 then
  1412.                  newdir:=newdir+path
  1413.                 else
  1414.                  newdir:='';
  1415.               until (dirlist='') or (newdir<>'');
  1416.               fsearch:=newdir;
  1417.            end;
  1418.       end;
  1419.  
  1420.  
  1421. Procedure getftime (var f; var time : longint);
  1422. {
  1423.     This function returns a file's date and time as the number of
  1424.     seconds after January 1, 1978 that the file was created.
  1425. }
  1426. var
  1427.     FInfo : pFileInfoBlock;
  1428.     FTime : Longint;
  1429.     FLock : Longint;
  1430.     Str   : String;
  1431.     i     : integer;
  1432. begin
  1433.     DosError:=0;
  1434.     FTime := 0;
  1435.     Str := StrPas(filerec(f).name);
  1436.     for i:=1 to length(Str) do
  1437.      if str[i]='\' then str[i]:='/';
  1438.     FLock := Lock(Str, SHARED_LOCK);
  1439.     IF FLock <> 0 then begin
  1440.         New(FInfo);
  1441.         if Examine(FLock, FInfo) then begin
  1442.              with FInfo^.fib_Date do
  1443.              FTime := ds_Days * (24 * 60 * 60) +
  1444.              ds_Minute * 60 +
  1445.              ds_Tick div 50;
  1446.         end else begin
  1447.              FTime := 0;
  1448.         end;
  1449.         Unlock(FLock);
  1450.         Dispose(FInfo);
  1451.     end
  1452.     else
  1453.      DosError:=6;
  1454.     time := FTime;
  1455. end;
  1456.  
  1457.  
  1458.   Procedure setftime(var f; time : longint);
  1459.    var
  1460.     DateStamp: pDateStamp;
  1461.     Str: String;
  1462.     i: Integer;
  1463.     Days, Minutes,Ticks: longint;
  1464.     FLock: longint;
  1465.   Begin
  1466.     new(DateStamp);
  1467.     Str := StrPas(filerec(f).name);
  1468.     for i:=1 to length(Str) do
  1469.      if str[i]='\' then str[i]:='/';
  1470.     { Check first of all, if file exists }
  1471.     FLock := Lock(Str, SHARED_LOCK);
  1472.     IF FLock <> 0 then
  1473.       begin
  1474.         Unlock(FLock);
  1475.         Amiga2DateStamp(time,Days,Minutes,ticks);
  1476.         DateStamp^.ds_Days:=Days;
  1477.         DateStamp^.ds_Minute:=Minutes;
  1478.         DateStamp^.ds_Tick:=Ticks;
  1479.         if SetFileDate(Str,DateStamp) <> 0 then
  1480.             DosError:=0
  1481.         else
  1482.             DosError:=6;
  1483.       end
  1484.     else
  1485.       DosError:=2;
  1486.     if assigned(DateStamp) then Dispose(DateStamp);
  1487.   End;
  1488.  
  1489.   Procedure getfattr(var f; var attr : word);
  1490.   var
  1491.     info : pFileInfoBlock;
  1492.     MyLock : Longint;
  1493.     flags: word;
  1494.     Str: String;
  1495.     i: integer;
  1496.   Begin
  1497.     DosError:=0;
  1498.     flags:=0;
  1499.     New(info);
  1500.     Str := StrPas(filerec(f).name);
  1501.     for i:=1 to length(Str) do
  1502.      if str[i]='\' then str[i]:='/';
  1503.     { open with shared lock to check if file exists }
  1504.     MyLock:=Lock(Str,SHARED_LOCK);
  1505.     if MyLock <> 0 then
  1506.       Begin
  1507.         Examine(MyLock,info);
  1508.         {*------------------------------------*}
  1509.         {* Determine if is a file or a folder *}
  1510.         {*------------------------------------*}
  1511.         if info^.fib_DirEntryType > 0 then
  1512.              flags:=flags OR DIRECTORY;
  1513.  
  1514.         {*------------------------------------*}
  1515.         {* Determine if Read only             *}
  1516.         {*  Readonly if R flag on and W flag  *}
  1517.         {*   off.                             *}
  1518.         {* Should we check also that EXEC     *}
  1519.         {* is zero? for read only?            *}
  1520.         {*------------------------------------*}
  1521.         if   ((info^.fib_Protection and FIBF_READ) <> 0)
  1522.          AND ((info^.fib_Protection and FIBF_WRITE) = 0)
  1523.          then
  1524.           flags:=flags OR ReadOnly;
  1525.         Unlock(mylock);
  1526.       end
  1527.     else
  1528.       DosError:=3;
  1529.     attr:=flags;
  1530.     Dispose(info);
  1531.   End;
  1532.  
  1533.  
  1534. Procedure setfattr (var f;attr : word);
  1535.   var
  1536.    flags: longint;
  1537.    MyLock : longint;
  1538.    str: string;
  1539.    i: integer;
  1540.   Begin
  1541.     DosError:=0;
  1542.     flags:=FIBF_WRITE;
  1543.     { open with shared lock }
  1544.     Str := StrPas(filerec(f).name);
  1545.     for i:=1 to length(Str) do
  1546.      if str[i]='\' then str[i]:='/';
  1547.  
  1548.     MyLock:=Lock(Str,SHARED_LOCK);
  1549.  
  1550.     { By default files are read-write }
  1551.     if attr AND ReadOnly <> 0 then
  1552.       { Clear the Fibf_write flags }
  1553.       flags:=FIBF_READ;
  1554.  
  1555.  
  1556.     if MyLock <> 0 then
  1557.      Begin
  1558.        Unlock(MyLock);
  1559.        if SetProtection(Str,flags) = 0 then
  1560.          DosError:=5;
  1561.      end
  1562.     else
  1563.       DosError:=3;
  1564.   End;
  1565.  
  1566.  
  1567.  
  1568. {******************************************************************************
  1569.                              --- Environment ---
  1570. ******************************************************************************}
  1571.  
  1572. var 
  1573. StrofPaths : string[255];
  1574.  
  1575. function getpathstring: string;
  1576. var
  1577.    f : text;
  1578.    s : string;
  1579.    found : boolean;
  1580.    temp : string[255];
  1581. begin
  1582.    found := true;
  1583.    temp := '';
  1584.    assign(f,'ram:makepathstr');
  1585.    rewrite(f);
  1586.    writeln(f,'path >ram:temp.lst');
  1587.    close(f);
  1588.    exec('c:protect','ram:makepathstr sarwed');
  1589.    exec('C:execute','ram:makepathstr');
  1590.    exec('c:delete','ram:makepathstr quiet');
  1591.    assign(f,'ram:temp.lst');
  1592.    reset(f);
  1593.    { skip the first line, garbage }
  1594.    if not eof(f) then readln(f,s);
  1595.    while not eof(f) do begin
  1596.       readln(f,s);
  1597.       if found then begin
  1598.          temp := s;
  1599.          found := false;
  1600.       end else begin;
  1601.          if (length(s) + length(temp)) < 255 then
  1602.             temp := temp + ';' + s;
  1603.       end;
  1604.    end;
  1605.    close(f);
  1606.    exec('C:delete','ram:temp.lst quiet');
  1607.    getpathstring := temp;
  1608. end;
  1609.  
  1610.  
  1611.  Function EnvCount: Longint;
  1612.  { HOW TO GET THIS VALUE:                                }
  1613.  {   Each time this function is called, we look at the   }
  1614.  {   local variables in the Process structure (2.0+)     }
  1615.  {   And we also read all files in the ENV: directory    }
  1616.   Begin
  1617.   End;
  1618.  
  1619.  
  1620.  Function EnvStr(Index: Integer): String;
  1621.   Begin
  1622.     EnvStr:='';
  1623.   End;
  1624.  
  1625.  
  1626.  
  1627. function GetEnv(envvar : String): String;
  1628. var
  1629.    bufarr : array[0..255] of char;
  1630.    strbuffer : array[0..255] of char;
  1631.    temp : Longint;
  1632. begin
  1633.    if UpCase(envvar) = 'PATH' then begin
  1634.        if StrOfpaths = '' then StrOfPaths := GetPathString;
  1635.        GetEnv := StrofPaths;
  1636.    end else begin
  1637.       move(envvar,strbuffer,length(envvar));
  1638.       strbuffer[length(envvar)] := #0;
  1639.       temp := GetVar(strbuffer,bufarr,255,$100);
  1640.       if temp = -1 then
  1641.         GetEnv := ''
  1642.       else GetEnv := StrPas(bufarr);
  1643.    end;
  1644. end;
  1645.  
  1646.  
  1647. {******************************************************************************
  1648.                              --- Not Supported ---
  1649. ******************************************************************************}
  1650.  
  1651. Procedure keep(exitcode : word);
  1652.   Begin
  1653.   { ! Not implemented in Linux ! }
  1654.   End;
  1655.  
  1656. procedure AddDevice(str : String);
  1657. begin
  1658.     inc(numberofdevices);
  1659.     deviceids[numberofdevices] := numberofdevices;
  1660.     devicenames[numberofdevices] := str;
  1661. end;
  1662.  
  1663. function MakeDeviceName(str : pchar): string;
  1664. var
  1665.    temp : string[20];
  1666. begin
  1667.    temp := strpas(str);
  1668.    temp := temp + ':';
  1669.    MakeDeviceName := temp;
  1670. end;
  1671.  
  1672. function IsInDeviceList(str : string): boolean;
  1673. var
  1674.    i : byte;
  1675.    theresult : boolean;
  1676. begin
  1677.    theresult := false;
  1678.    for i := low(not_to_use_devs) to high(not_to_use_devs) do
  1679.    begin
  1680.        if str = not_to_use_devs[i] then begin
  1681.           theresult := true;
  1682.           break;
  1683.        end;
  1684.    end;
  1685.    IsInDeviceList := theresult;
  1686. end;
  1687.  
  1688.  
  1689. function BSTR2STRING(s : BSTR): pchar;
  1690. begin
  1691.     BSTR2STRING := Pointer(Longint(BADDR(s))+1);
  1692. end;
  1693.  
  1694. procedure ReadInDevices;
  1695. var
  1696.    dl : pDosList;
  1697.    temp : pchar;
  1698.    str  : string[20];
  1699. begin
  1700.    dl := LockDosList(LDF_DEVICES or LDF_READ );
  1701.    repeat
  1702.       dl := NextDosEntry(dl,LDF_DEVICES );
  1703.       if dl <> nil then begin
  1704.          temp := BSTR2STRING(dl^.dol_Name);
  1705.          str := MakeDeviceName(temp);
  1706.          if not IsInDeviceList(str) then
  1707.               AddDevice(str);
  1708.       end;
  1709.    until dl = nil;
  1710.    UnLockDosList(LDF_DEVICES or LDF_READ );
  1711. end;
  1712.  
  1713. Begin
  1714.  DosError:=0;
  1715.  ver:=TRUE;
  1716.  breakflag:=TRUE;
  1717.  numberofdevices := 0;
  1718.  StrOfPaths := '';
  1719.  AddDevice('DF0:');
  1720.  AddDevice('DF1:');
  1721.  AddDevice('DF2:');
  1722.  AddDevice('DF3:');
  1723.  ReadInDevices;
  1724. End.
  1725.  
  1726. {
  1727.   $Log: dos.pp,v $
  1728.   Revision 1.8  1998/08/19 14:52:52  carl
  1729.     * SearchRec was not aligned!! so BOUM!...
  1730.  
  1731.   Revision 1.7  1998/08/17 12:30:42  carl
  1732.     * FExpand removes dot characters
  1733.     * Findfirst single/double dot expansion
  1734.     + SetFtime implemented
  1735.  
  1736.   Revision 1.6  1998/08/13 13:18:45  carl
  1737.     * FSearch bugfix
  1738.     * FSplit bugfix
  1739.     + GetFAttr,SetFAttr and GetFTime accept dos dir separators
  1740.  
  1741.   Revision 1.5  1998/08/04 13:37:10  carl
  1742.     * bugfix of findfirst, was not convberting correctl backslahes
  1743.  
  1744.        History (Nils Sjoholm):
  1745.        10.02.1998  First version for Amiga.
  1746.                    Just GetDate and GetTime.
  1747.  
  1748.        11.02.1998  Added AmigaToDt and DtToAmiga
  1749.                    Changed GetDate and GetTime to
  1750.                    use AmigaToDt and DtToAmiga.
  1751.  
  1752.                    Added DiskSize and DiskFree.
  1753.                    They are using a string as arg
  1754.                    have to try to fix that.
  1755.  
  1756.        12.02.1998  Added Fsplit and FExpand.
  1757.                    Cleaned up the unit and removed
  1758.                    stuff that was not used yet.
  1759.  
  1760.        13.02.1998  Added CToPas and PasToC and removed
  1761.                    the uses of strings.
  1762.  
  1763.        14.02.1998  Removed AmigaToDt and DtToAmiga
  1764.                    from public area.
  1765.                    Added deviceids and devicenames
  1766.                    arrays so now diskfree and disksize
  1767.                    is compatible with dos.
  1768.  
  1769.  
  1770.  
  1771. }
  1772.  
  1773.  
  1774.  
  1775.  
  1776.  
  1777.  
  1778.  
  1779.  
  1780.